home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d2 / qad.arc / QAD.BAS < prev    next >
BASIC Source File  |  1988-06-04  |  5KB  |  82 lines
  1. 10 DEFSTR A-H: E = INKEY$
  2. 20 DEF SEG = &H40: MON = PEEK(16) AND &H30
  3. 30 IF MON = 32 THEN PSCR = &HB800: PCOL = 224 ELSE PSCR = &HB000: PCOL = 16
  4. 50 DIM B(400), N(40), N1(40), G1(2): KEY OFF: DEF SEG = PSCR
  5. 60 DEF FNICOL (P) = (P \ 2) MOD 80 + 1: DEF FNIROW (P) = (P \ 2) \ 80 + 1
  6. 70 G = CHR$(34): G1(0) = G: G1(2) = G: G1(1) = ",": G2 = G + "," + G: GS = " ": GSC = " , ": GQC = G + ","
  7. 80 RFOR = 0:ZFOR = 0: RBAK = 7: ZBAK = 0:ZOLD=78:IF PSCR = &HB800 THEN ZFOR = 14: RFOR = 14: RBAK = 4
  8. 82 COLOR ZFOR, , 1: GOSUB 650
  9. 90 PRINT : LINE INPUT "FULL PATH NAME OF FILE TO CONVERT = "; FI: PPS = INSTR(FI, ".")
  10. 100 IF PPS = 0 THEN FI1 = FI ELSE FI1 = LEFT$(FI, PPS - 1)
  11. 110 PRINT : PRINT "FULL PATH NAME OF OUTPUT FILE (DEFAULT = "; FI1; ".PRN) = "; : LINE INPUT FIOUT
  12. 120 IF LEN(FIOUT) = 0 THEN FIOUT = FI1 + ".PRN"
  13. 130 OPEN "I", 1, FI
  14. 140 CLS : LINE INPUT #1, A
  15. 150 LOCATE 1, 1: PRINT A: L = LEN(A)
  16. 160 IF L = 0 THEN 140
  17. 170 LOCATE 4, 1: PRINT L; "IS THIS A GOOD RECORD (Y or N)? "; : GOSUB 360
  18. 180 IF E = "n" OR E = "N" THEN GOTO 140
  19. 190 FOR J = 0 TO 2 * L STEP 2: B(J \ 2 + 1) = CHR$(PEEK(J)): NEXT
  20. 200 CLS : LOCATE 1, 1, 0: PRINT GS; : POSHOLD = 0
  21. 210 FOR J = 1 TO L: PRINT B(J); : NEXT
  22. 220 POKEPOS = 3: LOCATE 8, 1: J = 1: JJ = 0: M = 1
  23. 225 PRINT "Marking Field #"; : LOCATE 10, 1: PRINT "Field    Length"; : LOCATE 12, 1: PRINT "Total length marked"
  24. 227 LOCATE 25, 1: COLOR , RBAK: PRINT "COMMA & QUOTE = <Q>"; : COLOR , ZBAK: PRINT "   "; : COLOR , RBAK: PRINT "LAST, FIRST NAME FIX = <N>"; : COLOR , ZBAK: PRINT "   "; : COLOR , RBAK: PRINT "COMMAS ONLY = <C>"; : COLOR , ZBAK
  25. 230 POKE POKEPOS, PCOL: OLDPOS = POKEPOS: LOCATE 8, 16: PRINT M; : LOCATE 10, 6: PRINT M; : LOCATE 10, 16: PRINT JJ; : LOCATE 12, 20: PRINT J - 1;
  26. 235 GOSUB 360:IF E >= "1" AND E <= "3" THEN 235
  27. 240 IF (E = "Q" OR E = "q") THEN E = "1" ELSE IF (E = "N" OR E = "n") THEN E = "2" ELSE IF (E = "C" OR E = "c") THEN E = "3"
  28. 250 IF E = "\" THEN CLOSE : GOTO 665
  29. 260 IF ASC(E) = 13 THEN POKE POKEPOS - 5, 32: POKE POKEPOS - 3, 32: GOTO 390
  30. 270 IF LEN(E) < 2 THEN 310
  31. 280 IF RIGHT$(E, 1) = "M" THEN 290 ELSE IF RIGHT$(E, 1) <> "K" THEN 230
  32. 284 JJ = JJ - 1: IF JJ < 0 THEN JJ = 0: GOTO 230 ELSE POKEPOS = POKEPOS - 2: J = J - 1: POKE OLDPOS, ZFOR: IF POKEPOS < 3 THEN POKEPOS = 3: J = 1: JJ = 0
  33. 288 GOTO 230
  34. 290 POKEPOS = POKEPOS + 2: J = J + 1: POKE OLDPOS, ZOLD: JJ = JJ + 1
  35. 300 GOTO 230
  36. 310 JCOMMA=0:IF E<>"2" THEN 315 ELSE FOR JCHECK=J-JJ TO J:JCOMMA=JCOMMA+(B(JCHECK)=",")*-1:NEXT JCHECK:IF JCOMMA<>1 THEN BEEP:GOTO 235
  37. 315 IF E = "1" OR E = "2" THEN GOSUB 370: G1(0) = G: G1(2) = G: GOSUB 380: POKE POSHOLD, 34: GOTO 330
  38. 320 IF E = "3" THEN GOSUB 370: G1(0) = GS: G1(2) = GS: GOSUB 380: POKE POSHOLD, 32: GOTO 330
  39. 325 GOTO 230
  40. 330 POKEPOS = POKEPOS + 6: POSHOLD = POKEPOS - 3: GOSUB 370: FOR KK = J TO L: PRINT B(KK); : NEXT: N(M) = JJ: JJ = 0: N1(M) = VAL(E)
  41. 340 M = M + 1: GOTO 230
  42. 360 E = INKEY$: IF E = "" THEN 360 ELSE RETURN
  43. 370 IR = FNIROW(POKEPOS): IC = FNICOL(POKEPOS): LOCATE IR, IC: RETURN
  44. 380 FOR II = 0 TO 2: PRINT G1(II); : NEXT: RETURN
  45. 390 CLOSE : M = M - 1: PRINT : PRINT : PRINT "Do Lower Case conversions? "; : GOSUB 360: IF E = "N" OR E = "n" THEN Y = 0 ELSE Y = 1
  46. 400 CLOSE : CLS : K = 0: FOR I = 1 TO M: PRINT I; "  "; : BQUOTE = G: IF N1(I) = 3 THEN BQUOTE = ""
  47. 405 PRINT BQUOTE; : FOR J = 1 TO N(I): PRINT B(J + K); : NEXT J: PRINT BQUOTE; : IF Y = 1 THEN PRINT  ELSE GOTO 420
  48. 410 PRINT "Convert? "; : GOSUB 360: PRINT E; : IF E = "Y" OR E = "y" THEN N1(I) = N1(I) * 10
  49. 420 K = K + N(I): PRINT : NEXT I: LOCATE 24, 1: PRINT "Hit any key to convert or '\' to restart"; : GOSUB 360: IF E = "\" THEN CLOSE : GOTO 665
  50. 425 IF E = "n" OR E = "N" OR E = "y" OR E = "Y" THEN GOSUB 360
  51. 430 LOCATE 22, 30: PRINT "CONVERTING...";
  52. 440 OPEN "I", 1, FI: OPEN "O", 2, FIOUT
  53. 450 WHILE NOT EOF(1): LINE INPUT #1, A
  54. 460 IF LEN(A) < 5 THEN 450
  55. 470 LOCATE 22, 44: LK = LK + 1: PRINT LK
  56. 480 K = 1: FOR I = 1 TO M:
  57. 490 AX = MID$(A, K, N(I))
  58. 500 IF N1(I) > 3 THEN GOSUB 590
  59. 510 IF (N1(I) = 1 OR N1(I) = 10) THEN PRINT #2, G; AX; G; : GOTO 550
  60. 520 IF (N1(I) = 3 OR N1(I) = 30) THEN PRINT #2, AX; : GOTO 550
  61. 530 NP = INSTR(AX, ","): AY = LEFT$(AX, NP - 1): AZ = RIGHT$(AX, N(I) - NP)
  62. 540 PRINT #2, G; AY; G2; AZ; G;
  63. 550 IF I < M THEN PRINT #2, ",";
  64. 560 K = K + N(I): NEXT I: PRINT #2, ""
  65. 570 WEND
  66. 580 CLOSE : PRINT : PRINT : PRINT : END
  67. 590 P = 1: FOR II = 1 TO LEN(AX): DD = MID$(AX, II, 1)
  68. 600 IF ((DD < "A" OR DD > "Z") AND (DD < "0" OR DD > "9")) THEN P = 1: GOTO 630
  69. 610 IF P = 1 THEN P = 0: GOTO 630
  70. 615 IF DD >= "0" AND DD <= "9" THEN 630
  71. 620 MID$(AX, II, 1) = CHR$(ASC(DD) + 32)
  72. 630 NEXT II
  73. 640 RETURN
  74. 650 CLS : LOCATE 3, 34: COLOR 28: PRINT "Q"; : COLOR ZFOR: PRINT "uick "; : COLOR 28: PRINT "A"; : COLOR ZFOR: PRINT "nd "; : COLOR 28: PRINT "D"; : COLOR ZFOR: PRINT "irty":
  75. 655 LOCATE 5, 24: PRINT "ASCII to FORMATTED file Converter": LOCATE 6, 32: PRINT "Kluged by Ken Gash"
  76. 660 RETURN
  77. 665 CLS : PRINT "Your input file is ---> "; : COLOR 28, 0: PRINT FI: COLOR ZFOR, ZBAK, 1: PRINT "  If OK, hit <ENTER> else type in new pathname.   ";
  78. 670 LINE INPUT AFILE: IF LEN(AFILE) <> 0 THEN FI = AFILE
  79. 675 PRINT : PRINT "Your output file is ---> "; : COLOR 28, 0: PRINT FIOUT: COLOR ZFOR, ZBAK, 1: PRINT "  If OK, hit <ENTER> else type in new pathname.   ";
  80. 680 LINE INPUT AFILE: IF LEN(AFILE) <> 0 THEN FIOUT = AFILE
  81. 685 PRINT : PRINT "Hit <ENTER> to continue or '\' to restart": GOSUB 360: IF E = "\" THEN 665 ELSE GOTO 130
  82.